home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1997
/
HAM Radio 1997.iso
/
vcls
/
ras_api
/
rascomp.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-08
|
12KB
|
404 lines
unit RASComp;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, RAS_API;
{ ********************************************************************** }
{ ********************************************************************** }
const
MaxConnections = 4;
type
TConnectionList = class(TList)
function AddConnection(Connection: TRASConn): Word;
function RASConn(Index: Integer): HRASConn;
function EntryName(Index: Integer): String;
procedure Delete(Index: Integer);
end;
TRAS = class(TComponent)
private
{ Private declarations }
fEntryName,
fPhoneNumber,
fPhoneBookPath,
fCallbackNumber,
fUserName,
fPassword,
fDomain,
fDeviceType,
fDeviceName: String;
fOnCallback,
fOnConnect,
fOnDisconnect: TNotifyEvent;
fWindowHandle: HWND;
RASEvent: Word;
procedure SetPhoneBookPath(Value: String);
procedure Connected;
procedure DisConnected;
procedure WaitingForCallBack;
procedure WndProc(var Msg: TMessage);
function IntDisConnect: LongInt; { Used internally to bypass fOnDisconnect }
protected
{ Protected declarations }
public
{ Public declarations }
PhoneBookEntries: TStringList;
Connections: TConnectionList;
LastError: LongInt;
RASConn: HRASConn; { Connection handle}
ConnectState: Word;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetConnectStatus: LongInt;
function DisConnect: LongInt;
function GetErrorString(ErrorCode: LongInt): String;
function Connect: LongInt;
function CurrentStatus: String;
function GetConnections: LongInt;
function GetPhoneBookEntries: LongInt;
published
{ Published declarations }
property EntryName: String read fEntryName write fEntryName;
property PhoneNumber: String read fPhoneNumber write fPhoneNumber;
property PhoneBookPath: String read fPhoneBookPath write SetPhoneBookPath;
property CallbackNumber: String read fCallbackNumber write fCallbackNumber;
property UserName: String read fUserName write fUserName;
property Password: String read fPassword write fPassword;
property Domain: String read fDomain write fDomain;
property DeviceType: String read fDeviceType write fDeviceType;
property DeviceName: String read fDeviceName write fDeviceName;
property OnConnect: TNotifyEvent read fOnconnect write fOnConnect;
property OnDisconnect: TNotifyEvent read fOnDisconnect write fOnDisconnect;
property OnCallBack: TNotifyEvent read fOnCallBack write fOnCallBack;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('RAS', [TRAS]);
end;
{ ********************************************************************* }
{ TConnectionList }
{ ********************************************************************* }
function TConnectionList.AddConnection(Connection: TRASConn): Word;
var
Conn: PRASConn;
begin
Conn := New(PRASConn);
Conn^ := Connection;
Add(Conn);
end;
function TConnectionList.RASConn(Index: Integer): HRASConn;
begin
Result := PRASConn(Items[Index])^.RASConn;
end;
function TConnectionList.EntryName(Index: Integer): String;
begin
If PRASConn(Items[Index])^.szEntryName[0] <> #0 THEN
Result := StrPas(PRASConn(Items[Index])^.szEntryName)
ELSE
Result := '';
end;
procedure TConnectionList.Delete(Index: Integer);
begin
Dispose(PRASConn(Items[Index]));
Items[Index] := Nil;
inherited Delete(Index);
end;
{ ********************************************************************* }
{ TRASConnection }
{ ********************************************************************* }
constructor TRAS.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
RASEvent := RegisterWindowMessage(RASDialEvent);
If RASEvent = 0 THEN
RASEvent := WM_RASDialEvent;
RASConn := 0;
ConnectState := 0;
fWindowHandle := 0;
PhoneBookEntries := TStringList.Create;
Connections := TConnectionList.Create;
end;
destructor TRAS.Destroy;
begin
IntDisconnect;
PhoneBookEntries.Free;
Connections.Free;
inherited Destroy;
end;
function TRAS.Connect: LongInt;
var
RASDialParams: TRASDialParams;{ points to calling parameters }
R: LongInt;
Blank: String;
begin
If RASConn <> 0 THEN { Allow only one connection }
IntDisConnect;
If fWindowHandle = 0 THEN
fWindowHandle := AllocateHWnd(WndProc);
FillChar(RASDialParams, SizeOf(RASDialParams), #0);
With RASDialParams DO
Begin
dwSize := SizeOf(RASDialParams);
Blank := fEntryName + #0;
StrLCopy(szEntryName, @Blank[1], RAS_MaxEntryName);
Blank := fPhoneNumber + #0;
StrLCopy(szPhoneNumber, @Blank[1], RAS_MaxPhoneNumber);
Blank := fCallBackNumber + #0;
StrLCopy(szCallbackNumber, @Blank[1], RAS_MaxCallbackNumber);
Blank := fUserName + #0;
StrLCopy(szUserName, @Blank[1], UNLEN);
Blank := fPassWord + #0;
StrLCopy(szPassword, @Blank[1], PWLEN);
Blank := fDomain + #0;
StrLCopy(szDomain, @Blank[1], DNLEN);
End;
If fPhoneBookPath <> '' THEN
Begin
Blank := fPhoneBookPath + #0;
LastError := RasDial(Nil, @Blank[1], @RASDialParams, Nil, fWindowHandle, RASConn);
End
ELSE
LastError := RasDial(Nil, Nil, @RASDialParams, Nil, fWindowHandle, RASConn);
Result := LastError;
end;
function TRAS.GetErrorString(ErrorCode: LongInt): String;
var
szErrorString: Array[0..256] of Char;
begin
Result := '';
If (RASConn = 0) THEN
Exit;
FillChar(szErrorString, SizeOf(szErrorString), #0);
RasGetErrorString(ErrorCode, szErrorString, 256);
If szErrorString[0] <> #0 THEN
Result := StrPas(szErrorString)
Else
Result := 'Status Unknown';
end;
function TRAS.Disconnect: LongInt;
begin
Result := 0;
If RASConn <> 0 THEN
Result := RASHangUp(RASConn);
RASConn := 0;
If fWindowHandle <> 0 THEN { Stop message flow }
Begin
DeallocateHWnd(fWindowHandle);
fWindowHandle := 0;
End;
LastError := Result;
Disconnected;
end;
function TRAS.IntDisconnect: LongInt;
begin
Result := 0;
If RASConn <> 0 THEN
Result := RASHangUp(RASConn);
RASConn := 0;
If fWindowHandle <> 0 THEN { Stop message flow }
Begin
DeallocateHWnd(fWindowHandle);
fWindowHandle := 0;
End;
LastError := Result;
end;
function TRAS.GetConnectStatus: LongInt;
var
RASConnStatus: TRASConnStatus;
begin
If (RASConn = 0) THEN
Exit;
FillChar(RASConnStatus, SizeOf(RASConnStatus), #0);
RASConnStatus.dwSize := 60;
LastError := RasGetConnectStatus(RASConn, @RASConnStatus);
If LastError = 0 THEN
begin
fDeviceName := StrPas(RASConnStatus.szDeviceName);
fDeviceType := StrPas(RASConnStatus.szDeviceType);
ConnectState := RASConnStatus.rasconnstate;
end;
LastError := RASConnStatus.dwError;
Result := LastError;
end;
function TRAS.GetConnections: LongInt;
var
RASConnect: Array[1..MaxConnections] OF TRASConn;
I,
BufSize,
NumConnections: Word;
begin
Connections.Clear;
RASConnect[1].dwSize := 30;
BufSize := SizeOf(RASConnect);
Result := RasEnumConnections(@RASConnect, BufSize, NumConnections);
LastError := Result;
If (Result = 0) OR (Result = ERROR_BUFFER_TOO_SMALL) THEN
For I := 1 TO NumConnections DO
If (I <= MaxConnections) THEN
Connections.AddConnection(RASConnect[I]);
end;
function TRAS.GetPhoneBookEntries;
var
RASEntryName: Array[1..20] Of TRASENTRYNAME;
I,
BufSize,
Entries: Word;
szPhoneBookPath: PChar;
begin
PhoneBookEntries.Clear;
RASEntryName[1].dwSize := 26;
BufSize := SizeOf(RASEntryName);
If fPhoneBookPath <> '' THEN
Begin
GetMem(szPhoneBookPath, Length(fPhoneBookPath) + 1);
StrPCopy(szPhoneBookPath, fPhoneBookPath);
Result := RasEnumEntries(Nil, szPhonebookPath, @RASEntryName,
BufSize, Entries);
FreeMem(szPhoneBookPath, Length(fPhoneBookPath) + 1);
End
ELSE
Result := RasEnumEntries(Nil, Nil, @RASEntryName, BufSize, Entries);
LastError := Result;
If (Result = 0) OR (Result = ERROR_BUFFER_TOO_SMALL) THEN
For I := 1 TO Entries DO
If ( I < 21) AND (RASEntryName[I].szEntryName[0] <> #0) THEN
PhoneBookEntries.Add(StrPas(RASEntryName[I].szEntryName));
end;
procedure TRAS.WndProc(var Msg: TMessage);
begin
If (Msg.Msg = RASEvent) AND (RASConn <> 0) THEN
Begin
If Msg.lParam <> 0 THEN
LastError := Msg.lParam
ELSE
Begin
ConnectState := Msg.wParam;
Case ConnectState OF
RASCS_DeviceConnected: Connected;
RASCS_WaitForCallBack: WaitingForCallBack;
End;
End;
CurrentStatus;
End
ELSE
DefWindowProc(fWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;
function TRAS.CurrentStatus: String;
begin
Result := '';
If (RASConn = 0) THEN
Begin
Result := 'Not Active';
Exit;
End;
If RASConn <> 0 THEN
Begin
GetConnectStatus;
If LastError <> 0 THEN
Begin
If LastError >= 600 THEN
Result := GetErrorString(LastError)
ELSE
Case LastError OF
6: Result := 'Invalid Handle';
8: Result := 'Not enough memory';
End;
End
ELSE
Case ConnectState OF
RASCS_OpenPort:
Result := 'Opening Port';
RASCS_PortOpened:
Result := 'Port Opened';
RASCS_ConnectDevice:
Result := 'Using Device: ' + fDeviceName + ' - ' + fDeviceType;
RASCS_DeviceConnected:
Result := 'Device is connected';
RASCS_AllDevicesConnected:
Result := 'All Required Devices Connected';
RASCS_Authenticate:
Result := 'Validating User/Password/Domain';
RASCS_AuthNotify:
Result := 'Authentication Notification';
RASCS_AuthCallBack:
Result := 'Authentication Call Back';
RASCS_AuthProject:
Result := 'Project';
RASCS_AuthLinkSpeed:
Result := 'Calculating Link speed';
RASCS_AuthAck:
Result := 'Authentication acknowledged';
RASCS_ReAuthenticate:
Result := 'Reauthenticating';
RASCS_Authenticated:
Result := 'Login Authenticated';
RASCS_PrepareforCallBack:
Result := 'Preparing for Callback';
RASCS_WaitForModemReset:
Result := 'Waiting for Modem Reset';
RASCS_WaitForCallBack:
Result := 'Waiting for Callback';
End; { Case }
End
ELSE
Result := 'Not Connected';
end;
procedure TRAS.SetPhoneBookPath(Value: String);
begin
fPhoneBookPath := Value;
GetPhoneBookEntries;
end;
procedure TRAS.Connected;
begin
If (RASConn = 0) THEN
Exit;
If Assigned(fOnConnect) THEN
fOnConnect(Self);
end;
procedure TRAS.DisConnected;
begin
If (RASConn = 0) THEN
Exit;
If Assigned(fOnDisConnect) THEN
fOnDisConnect(Self);
end;
procedure TRAS.WaitingForCallBack;
begin
If (RASConn = 0) THEN
Exit;
If Assigned(fOnCallBack) THEN
fOnCallBack(Self);
end;
end.